{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

module CheckboxList
  ( CheckboxList

  -- * Constructing a checkboxlist
  , makeList
  , checkboxListField

  -- * Rendering a list
  , renderList

  -- * Handling events
  , handleListEvent

  -- * Handle list status
  , listMoveTo
  , listMoveBy
  , listMoveUp
  , listMoveDown
  , getListContents

  -- * Attributes
  , listAttr
  , listSelectedAttr
  , listSelectedFocusedAttr
  ) where

import Brick.Types
  ( EventM
  , BrickEvent(..)
  , Widget(..)
  , Size(..)
  , ViewportType(..)
  , suffixLenses
  )
import Brick.Widgets.Core
  ( Named(..)
  , TextWidth(..)
  , viewport
  , hBox
  , vBox
  , str
  , txt
  , withDefAttr
  , visible
  )
import Brick.Forms
  ( FormFieldState(..)
  , FormField(..)
  , FormFieldVisibilityMode(..)
  )
import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L
import Brick.AttrMap
import Control.Monad.State (modify, get, put, evalState)
import qualified Data.Vector as V
import Data.Functor (($>))
import Data.Foldable (toList)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Zipper.Generic as Z
import GHC.Generics (Generic)
import GHC.Base
  ( Semigroup(..)
  , NonEmpty(..)
  )
import Graphics.Vty
  ( Event(..)
  , Key(..)
  , Modifier(..)
  )
import Lens.Micro.Platform

import DataType (SubTask(..))

data ListElement n e =
  ListElement { elemChecked :: Bool
              , elemEditor :: E.Editor e n
              } deriving (Generic, Show)

suffixLenses ''ListElement

data CheckboxList n t e =
  CheckboxList { listElements :: !(t (ListElement n e))
               -- ^ The list's sequence of elements.
               , listSelected :: !(Maybe Int)
               -- ^ The list's selected element index, if any.
               , listName :: n
               -- ^ The list's name.
               , nameMaker :: Int -> n
               -- ^ editor name maker
               } deriving (Generic)

suffixLenses ''CheckboxList

instance Named (CheckboxList n t e) n where
  getName = listName

handleListEvent :: (Ord n, E.DecodeUtf8 a, Eq a, Z.GenericTextZipper a)
                => BrickEvent n e
                -> EventM n (CheckboxList n V.Vector a) ()
handleListEvent (VtyEvent (EvKey KUp [])) = modify listMoveUp
handleListEvent (VtyEvent (EvKey KDown [])) = modify listMoveDown
handleListEvent (VtyEvent (EvKey KEnter [])) = modify listNewLine where
  listNewLine l =
    let pos = case l^.listSelectedL of
          Nothing -> 0
          Just s -> s + 1
        newElem = emptyListElement pos (l^.nameMakerL)
    in listAppend newElem l
handleListEvent ev@(VtyEvent (EvKey KBS [])) = do
  l <- get
  let els = l^.listElementsL
      sel = l^.listSelectedL
  case sel of
    Nothing -> return ()
    Just i -> do
      let e = (els V.! i)^.elemEditorL
          c = E.getEditContents e
      if length els > 1 && (null c || (null . Z.toList $ c !! 0))
        then modify listRemove
        else zoom (listElementsL.(ix i).elemEditorL) $ E.handleEditorEvent ev
handleListEvent (VtyEvent (EvKey (KChar 't') [MCtrl])) = do
  sel <- use listSelectedL
  case sel of
    Nothing -> return ()
    Just i -> listElementsL.(ix i).elemCheckedL %= not
handleListEvent e = do
  l <- get
  case l^.listSelectedL of
    Nothing -> return ()
    Just i -> zoom (listElementsL.(ix i).elemEditorL) $ E.handleEditorEvent e

listMoveTo :: (Foldable t)
           => Int
           -> CheckboxList n t e
           -> CheckboxList n t e
listMoveTo pos l = l & listSelectedL .~ if null (l ^. listElementsL) then Nothing else Just s where
  len = length $ l ^. listElementsL
  i = if pos < 0 then len + pos else pos
  s = max 0 $ min i $ len - 1

listMoveBy :: (Foldable t)
           => Int
           -> CheckboxList n t e
           -> CheckboxList n t e
listMoveBy amt l = l & listSelectedL .~ if null (l ^. listElementsL) then Nothing else Just s where
  len = length $ l ^. listElementsL
  s = case l ^. listSelectedL of
    Nothing -> 0
    Just c -> mod (c + amt) len

listMoveUp :: (Foldable t)
           => CheckboxList n t e
           -> CheckboxList n t e
listMoveUp = listMoveBy (-1)

listMoveDown :: (Foldable t)
             => CheckboxList n t e
             -> CheckboxList n t e
listMoveDown = listMoveBy 1

emptyListElement :: (Z.GenericTextZipper e)
                 => Int
                 -> (Int -> n)
                 -> ListElement n e
emptyListElement i make = ListElement False e where
  e = E.editor (make i) (Just 1) mempty

updateEditorName :: (Int -> n)
                 -> Int
                 -> ListElement n e
                 -> ListElement n e
updateEditorName make i = elemEditorL . editorNameL .~ make i where
  editorNameL = lens g s
  g e = E.editorName e
  s e n = e { E.editorName = n }

imap :: (Traversable t) => (Int -> a -> b) -> t a -> t b
imap f xs =
    let act = traverse (\a -> get >>= \i -> put (i + 1) $> f i a) xs
    in evalState act 0

listAppend :: (L.Splittable t, Applicative t, Traversable t, Semigroup (t (ListElement n e)))
           => ListElement n e
           -> CheckboxList n t e
           -> CheckboxList n t e
listAppend e l = l & listSelectedL .~ Just newSel
                   & listElementsL .~ els''
  where
    els = l^.listElementsL
    newSel = case l^.listSelectedL of
      Nothing -> 0
      Just s -> s + 1
    (front, back) = L.splitAt newSel els
    make = l^.nameMakerL
    els' = sconcat (front :| [pure e, back])
    els'' = imap (updateEditorName make) els'

listRemove :: (L.Splittable t, Traversable t, Semigroup (t (ListElement n e)))
           => CheckboxList n t e
           -> CheckboxList n t e
listRemove l = l & listSelectedL .~ newSel
                 & listElementsL .~ els''
  where
    els = l^.listElementsL
    newSel = l^.listSelectedL <&> \i -> max 0 (i - 1)
    splitIdx = fromMaybe 0 (l^.listSelectedL)
    (front, back) = L.splitAt splitIdx els
    (_, back') = L.splitAt 1 back
    make = l^.nameMakerL
    els' = sconcat (front :| [back'])
    els'' = imap (updateEditorName make) els'

listAttr :: AttrName
listAttr = attrName "checkboxlist"

listSelectedAttr :: AttrName
listSelectedAttr = listAttr <> attrName "selected"

listSelectedFocusedAttr :: AttrName
listSelectedFocusedAttr = listSelectedAttr <> attrName "focused"

makeList :: n
         -> V.Vector SubTask
         -> (Int -> n)
         -> CheckboxList n V.Vector T.Text
makeList name els make = CheckboxList e s name make where
  els' = if null els then V.fromList [mempty] else els
  s = Just 0
  e = V.imap f els'
  f i (SubTask c d) = ListElement c (E.editor (make i) (Just 1) d)

checkboxListField :: forall s e n . (Ord n, Show n)
                  => Lens' s (V.Vector SubTask)
                  -- ^ The state lens for value
                  -> n
                  -- ^ The resource name for the checkbox list
                  -> (Int -> n)
                  -- ^ The editor name maker
                  -> s
                  -- ^ The initial form state
                  -> FormFieldState s e n
checkboxListField l n m s =
  FormFieldState { formFieldState = checkboxList
                 , formFields = [ customField ]
                 , formFieldLens = l
                 , formFieldUpdate = update
                 , formFieldRenderHelper = id
                 , formFieldConcat = vBox
                 , formFieldVisibilityMode = ShowFocusedFieldOnly
                 } where
  checkboxList = makeList n (s^.l) m
  update a = const $ makeList n a m
  customField =
    FormField { formFieldName = n
              , formFieldValidate = Just . getListContents
              , formFieldExternallyValid = True
              , formFieldRender = renderList (txt . T.unlines)
              , formFieldHandleEvent = handleListEvent
              }

getListContents :: CheckboxList n V.Vector T.Text
                -> V.Vector SubTask
getListContents l = getter <$> (l^.listElementsL) where
  getter (ListElement c e) = SubTask c (T.unlines $ E.getEditContents e)

renderList :: ( Ord n, Show n
              , TextWidth e , Z.GenericTextZipper e
              , Traversable t
              )
           => ([e] -> Widget n)
           -- ^ rendering function
           -> Bool
           -- ^ Whether the list has focus
           -> CheckboxList n t e
           -- ^ The list to be rendered
           -> Widget n
           -- ^ rendered widget
renderList draw foc l = drawListElements foc l draw

drawListElements :: ( Ord n, Show n
                    , TextWidth e , Z.GenericTextZipper e
                    , Traversable t
                    )
                 => Bool
                 -> CheckboxList n t e
                 -> ([e] -> Widget n)
                 -> Widget n
drawListElements foc l draw = Widget Greedy Greedy $ do
  let drawElement i (ListElement c e) = makeVisible item where
        isSelected = Just i == (l^.listSelectedL)
        selItemAttr =
          if foc
          then withDefAttr listSelectedFocusedAttr
          else withDefAttr listSelectedAttr
        makeVisible =
          if isSelected
          then visible . selItemAttr
          else withDefAttr listAttr
        checkbox = str $ if c then "- [X] " else "- [ ] "
        editor = E.renderEditor draw (foc && isSelected) e
        item = hBox [ checkbox
                    , editor
                    ]
  render $ viewport (l^.listNameL) Vertical $
    vBox $ toList $ imap drawElement (l^.listElementsL)
